home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / cocktail / front.lha / front / src / Errors.mi < prev    next >
Text File  |  1992-08-18  |  12KB  |  456 lines
  1. (* handle and log errors *)
  2.  
  3. (* $Id: Errors.mi,v 2.4 1992/08/07 15:13:51 grosch rel $ *)
  4.  
  5. (* $Log: Errors.mi,v $
  6.  * Revision 2.4  1992/08/07  15:13:51  grosch
  7.  * allow several scanner and parsers; extend module Errors
  8.  *
  9.  * Revision 2.3  1992/01/30  13:34:33  grosch
  10.  * redesign of interface to operating system
  11.  *
  12.  * Revision 2.2  1991/11/21  14:47:50  grosch
  13.  * new version of RCS on SPARC
  14.  *
  15.  * Revision 2.1  91/03/19  14:47:01  grosch
  16.  * print error message if ErrorTab can not be opened
  17.  * 
  18.  * Revision 2.0  91/03/08  18:26:17  grosch
  19.  * turned tables into initialized arrays (in C)
  20.  * moved mapping tokens -> strings from Errors to Parser
  21.  * changed interface for source position
  22.  * 
  23.  * Revision 1.1  90/06/11  18:44:45  grosch
  24.  * layout improvements
  25.  * 
  26.  * Revision 1.0     88/10/04  14:26:44  vielsack
  27.  * Initial revision
  28.  * 
  29.  *)
  30.  
  31. IMPLEMENTATION MODULE Errors;
  32.  
  33. FROM    IO        IMPORT    tFile,        StdError,    WriteC, 
  34.                 WriteNl,    WriteS,        WriteI,
  35.                 WriteLong,    WriteB,        WriteR,
  36.                 ReadOpen,    ReadClose,    EndOfFile,
  37.                 CloseIO;
  38. FROM    Listing        IMPORT    tListMode,    ListMode,    PutError,
  39.                 HasError,    GetError;
  40. FROM    Memory        IMPORT    Alloc;
  41. FROM    Sets        IMPORT    tSet,        MakeSet,    IsElement,
  42.                 Assign;
  43. FROM    Strings        IMPORT    tString,    AssignEmpty,    SubString,
  44.                 Char,        ReadL,        Length,
  45.                 ArrayToString,    StringToInt;
  46. FROM    StringMem    IMPORT    tStringRef,    PutString,    GetString,
  47.                 WriteString;
  48. FROM    Idents        IMPORT    tIdent,        WriteIdent;
  49. FROM    SysError    IMPORT    StatIsBad,    SysErrorMessageI;
  50. FROM    System        IMPORT    Exit;
  51. FROM    SYSTEM        IMPORT    ADDRESS,    ADR,        TSIZE;
  52. FROM    TokenTab    IMPORT    TokenError,    TokenToSymbol,    MAXTerm;
  53. FROM    Positions    IMPORT    tPosition,    NoPosition;
  54.  
  55. IMPORT Strings;
  56.  
  57. CONST
  58.   eNone        = 0    ;    (* for internal use    *)
  59.   cTab        = 11C    ;    (* tab character    *)
  60.   NoStringRef    = -1    ;
  61.  
  62.   MaxCode    = 160    ;
  63.   eWrongClass    = 16    ;
  64.   eWrongCode    = 17    ;
  65.  
  66. VAR 
  67.   NoReports    : BOOLEAN;
  68.   ReportMode    : tReportMode;
  69.   ErrorClassRef : ARRAY [0..MaxErrorClass] OF tStringRef;
  70.   ErrorCodeRef    : ARRAY [0..MaxCode]  OF tStringRef;
  71.   ErrorCountRef : ARRAY [0..MaxErrorClass] OF tStringRef;
  72.   i        : CARDINAL;    (* index to initialize date structure *)
  73.  
  74. PROCEDURE ErrorMessage    (ErrorCode, ErrorClass: CARDINAL; Position: tPosition);
  75.    BEGIN
  76.       ErrorMessageI (ErrorCode, ErrorClass, Position, eNone, NIL);
  77.    END ErrorMessage;
  78.  
  79. PROCEDURE ErrorMessageI (ErrorCode, ErrorClass: CARDINAL; Position: tPosition;
  80.              InfoClass: CARDINAL; Info: ADDRESS);
  81.    BEGIN
  82.       INC (ErrorCount [ErrorClass]);
  83.       IF ErrorClass IN ReportClass THEN
  84.     NoReports := FALSE;
  85.     IF ReportMode = eImmediate THEN
  86.       WriteErrorMessage (ErrorCode, ErrorClass, Position.Line, Position.Column);
  87.       WriteInfo (InfoClass, Info);
  88.       WriteNl (StdError);
  89.     ELSE
  90.       KeepInfo (InfoClass, Info);
  91.       PutError (ErrorCode, ErrorClass, Position.Line, Position.Column, InfoClass, Info);
  92.     END;
  93.       END;
  94.       IF ErrorClass < 3 THEN Finish END;
  95.    END ErrorMessageI;
  96.  
  97. PROCEDURE SetReportMode (mode: tReportMode);
  98.   BEGIN
  99.     ReportMode := mode;
  100.     CASE ReportMode OF
  101.       eListing :
  102.     ListMode := Listing;
  103.     ELSE
  104.     ListMode := NoListing;
  105.     END;
  106.   END SetReportMode;
  107.  
  108. PROCEDURE BeginErrors;
  109.   VAR
  110.     i : CARDINAL;
  111.     f : tFile;
  112.     s : tString;
  113.     line : tString;
  114.   BEGIN
  115.     f := ReadOpen (ErrorTable);
  116.     IF StatIsBad (f) THEN
  117.       WriteS (StdError, 'Fatal error: cannot open ');
  118.       WriteS (StdError, ErrorTable);
  119.       WriteNl (StdError);
  120.       RETURN;
  121.     END;
  122.  
  123.     LOOP
  124.       IF EndOfFile (f) THEN EXIT; END;
  125.       ReadL (f, line);
  126.       IF Char (line, 1) = '$' THEN EXIT; END;
  127.       IF Char (line, 1) # '%' THEN
  128.     SplitLine (line, i, s);
  129.     IF (i<0) OR (i>MaxErrorClass) THEN
  130.       ErrorMessageI (eWrongClass, eError, NoPosition, eString, ADR(line));
  131.     ELSE
  132.       ErrorClassRef [i] := PutString (s);
  133.     END;
  134.       END;
  135.     END;
  136.  
  137.     LOOP
  138.       IF EndOfFile (f) THEN EXIT; END;
  139.       ReadL (f, line);
  140.       IF Char (line, 1) = '$' THEN EXIT; END;
  141.       IF Char (line, 1) # '%' THEN
  142.     SplitLine (line, i, s);
  143.     IF (i<0) OR (i>MaxCode) THEN
  144.       ErrorMessageI (eWrongCode, eError, NoPosition, eString, ADR(line));
  145.     ELSE
  146.       ErrorCodeRef [i] := PutString (s);
  147.     END;
  148.       END;
  149.     END;
  150.  
  151.     LOOP
  152.       IF EndOfFile (f) THEN EXIT; END;
  153.       ReadL (f, line);
  154.       IF Char (line, 1) = '$' THEN EXIT; END;
  155.       IF Char (line, 1) # '%' THEN
  156.     SplitLine (line, i, s);
  157.     IF (i<0) OR (i>MaxErrorClass) THEN
  158.       ErrorMessageI (eWrongClass, eError, NoPosition, eString, ADR(line));
  159.     ELSE
  160.       ErrorCountRef [i] := PutString (s);
  161.     END;
  162.       END;
  163.     END;
  164.     ReadClose (f);
  165.   END BeginErrors;
  166.  
  167. PROCEDURE CloseErrors ();
  168.    VAR 
  169.      i : CARDINAL;
  170.      r : tStringRef;
  171.      ErrorCode, ErrorClass, Line, Column, InfoClass: CARDINAL;
  172.      Info : ADDRESS;
  173.    BEGIN
  174.      IF NoReports THEN RETURN END;
  175.  
  176.      WHILE HasError() DO
  177.     GetError (ErrorCode, ErrorClass, Line, Column, InfoClass, Info);
  178.     WriteErrorMessage (ErrorCode, ErrorClass, Line, Column);
  179.     WriteInfo (InfoClass, Info);
  180.     WriteNl (StdError);
  181.      END;
  182.  
  183.      FOR i := 0 TO MaxErrorClass DO
  184.        IF ErrorCount [i] > 0 THEN
  185.      WriteS (StdError, '  ');
  186.      WriteI (StdError, ErrorCount [i], 1);
  187.      WriteC (StdError, ' ');
  188.  
  189.      r := ErrorCountRef [i];
  190.      IF r = NoStringRef THEN
  191.        WriteS (StdError, 'in error class ');
  192.        WriteI (StdError, i, 1);
  193.      ELSE
  194.        WriteString (StdError, r);
  195.      END;
  196.        END;
  197.      END; 
  198.      WriteNl (StdError);
  199.    END CloseErrors;
  200.  
  201. PROCEDURE WriteErrorMessage (ErrorCode, ErrorClass, Line, Column: CARDINAL);
  202.    VAR r : tStringRef;
  203.    BEGIN
  204.       IF (ReportMode # eListing) & (Line # 0) THEN
  205.     WriteI (StdError, Line, 3);
  206.     WriteS (StdError, ', ');
  207.       END;
  208.       IF Column # 0 THEN
  209.     WriteI (StdError, Column, 2);
  210.     WriteS (StdError, ': ');
  211.       END;
  212.  
  213.       IF (ErrorClass > MaxErrorClass) OR (ErrorClass < 0) THEN
  214.     WriteS (StdError, 'Error class: ');
  215.     WriteI (StdError, ErrorClass, 1);
  216.       ELSE
  217.     r := ErrorClassRef [ErrorClass];
  218.     IF r = NoStringRef THEN
  219.       WriteS (StdError, 'Error class: ');
  220.       WriteI (StdError, ErrorClass, 1);
  221.     ELSE
  222.       WriteString (StdError, r);
  223.     END;
  224.       END;
  225.  
  226.       IF (ErrorCode > MaxCode) OR (ErrorCode < 0) THEN
  227.     IF ErrorCode >= SysOffset THEN
  228.       WriteS (StdError, ' system error code: ');
  229.       WriteI (StdError, ErrorCode - SysOffset, 1);
  230.     ELSE
  231.       WriteS (StdError, ' error code: ');
  232.       WriteI (StdError, ErrorCode, 1);
  233.     END;
  234.       ELSE
  235.     r := ErrorCodeRef [ErrorCode];
  236.     IF r = NoStringRef THEN
  237.       IF ErrorCode >= SysOffset THEN
  238.         WriteS (StdError, ' system error code: ');
  239.         WriteI (StdError, ErrorCode - SysOffset, 1);
  240.       ELSE
  241.         WriteS (StdError, ' error code: ');
  242.         WriteI (StdError, ErrorCode, 1);
  243.       END;
  244.     ELSE
  245.       WriteString (StdError, r);
  246.     END;
  247.       END;
  248.    END WriteErrorMessage;
  249.  
  250. PROCEDURE KeepInfo  (InfoClass: CARDINAL; VAR Info: ADDRESS);
  251.    VAR
  252.       InfPtrToInteger,    PtrToInteger    : POINTER TO INTEGER;
  253.       InfPtrToShort,    PtrToShort    : POINTER TO SHORTCARD;
  254.       InfPtrToLong,    PtrToLong    : POINTER TO LONGINT;
  255.       InfPtrToReal,    PtrToReal    : POINTER TO REAL;
  256.       InfPtrToBoolean,    PtrToBoolean    : POINTER TO BOOLEAN;
  257.       InfPtrToCharacter,PtrToCharacter    : POINTER TO CHAR;
  258.       InfPtrToString,    PtrToString    : POINTER TO tString;
  259.       InfPtrToArray,    PtrToArray    : POINTER TO ARRAY [0..255] OF CHAR;
  260.       InfPtrToSet,    PtrToSet    : POINTER TO tSet;
  261.       InfPtrToIdent,    PtrToIdent    : POINTER TO tIdent;
  262.    BEGIN
  263.       IF InfoClass = eNone THEN RETURN END;
  264.       CASE InfoClass OF
  265.  
  266.       |     eInteger: 
  267.         InfPtrToInteger := Alloc (TSIZE (INTEGER));
  268.         PtrToInteger := Info;
  269.         InfPtrToInteger^ := PtrToInteger^;
  270.         Info := InfPtrToInteger;
  271.       |     eShort:
  272.         InfPtrToShort := Alloc (TSIZE (SHORTCARD));
  273.         PtrToShort := Info;
  274.         InfPtrToShort^ := PtrToShort^;
  275.         Info := InfPtrToShort;
  276.       |     eLong:
  277.         InfPtrToLong := Alloc (TSIZE (LONGINT));
  278.         PtrToLong := Info;
  279.         InfPtrToLong^ := PtrToLong^;
  280.         Info := InfPtrToLong;
  281.       |     eReal:
  282.         InfPtrToReal := Alloc (TSIZE (REAL));
  283.         PtrToReal := Info;
  284.         InfPtrToReal^ := PtrToReal^;
  285.         Info := InfPtrToReal;
  286.       |     eBoolean:
  287.         InfPtrToBoolean := Alloc (TSIZE (BOOLEAN));
  288.         PtrToBoolean := Info;
  289.         InfPtrToBoolean^ := PtrToBoolean^;
  290.         Info := InfPtrToBoolean;
  291.       |     eCharacter:
  292.         InfPtrToCharacter := Alloc (TSIZE (CHAR));
  293.         PtrToCharacter := Info;
  294.         InfPtrToCharacter^ := PtrToCharacter^;
  295.         Info := InfPtrToCharacter;
  296.       |     eString:
  297.         InfPtrToString := Alloc (TSIZE (tString));
  298.         PtrToString := Info;
  299.         Strings.Assign (InfPtrToString^, PtrToString^);
  300.         Info := InfPtrToString;
  301.       |     eArray:
  302.         InfPtrToArray := Alloc (256);
  303.         PtrToArray := Info;
  304.         InfPtrToArray^ := PtrToArray^;
  305.         Info := InfPtrToArray;
  306.       |     eIdent:
  307.         InfPtrToIdent := Alloc (TSIZE (tIdent));
  308.         PtrToIdent := Info;
  309.         InfPtrToIdent^ := PtrToIdent^;
  310.         Info := InfPtrToIdent;
  311.       |     eTermSet:
  312.         InfPtrToSet := Alloc (TSIZE (tSet));
  313.         PtrToSet := Info;
  314.         MakeSet (InfPtrToSet^, PtrToSet^.MaxElmt);
  315.         Assign (InfPtrToSet^, PtrToSet^);
  316.         Info := InfPtrToSet;
  317.       ELSE
  318.       END;
  319.    END KeepInfo;
  320.  
  321. PROCEDURE WriteInfo (InfoClass: CARDINAL; Info: ADDRESS);
  322.    VAR
  323.       PtrToInteger    : POINTER TO INTEGER;
  324.       PtrToShort    : POINTER TO SHORTCARD;
  325.       PtrToLong        : POINTER TO LONGINT;
  326.       PtrToReal        : POINTER TO REAL;
  327.       PtrToBoolean    : POINTER TO BOOLEAN;
  328.       PtrToCharacter    : POINTER TO CHAR;
  329.       PtrToString    : POINTER TO tString;
  330.       PtrToArray    : POINTER TO ARRAY [0..255] OF CHAR;
  331.       PtrToSet        : POINTER TO tSet;
  332.       PtrToIdent    : POINTER TO tIdent;
  333.    BEGIN
  334.       IF InfoClass = eNone THEN RETURN END;
  335.  
  336.       WriteC (StdError, ' ');
  337.       CASE InfoClass OF
  338.       |     eInteger: 
  339.         PtrToInteger := Info;
  340.         WriteI (StdError, PtrToInteger^, 1);
  341.       |     eShort: 
  342.         PtrToShort := Info;
  343.         WriteI (StdError, PtrToShort^, 1);
  344.       |     eLong:
  345.         PtrToLong := Info;
  346.         WriteLong (StdError, PtrToLong^, 1);
  347.       |     eReal:
  348.         PtrToReal := Info;
  349.         WriteR (StdError, PtrToReal^, 1, 10, 1);
  350.       |     eBoolean:
  351.         PtrToBoolean := Info;
  352.         WriteB (StdError, PtrToBoolean^);
  353.       |     eCharacter:
  354.         PtrToCharacter := Info;
  355.         WriteC (StdError, PtrToCharacter^);
  356.       |     eString:
  357.         PtrToString := Info;
  358.         Strings.WriteS (StdError, PtrToString^);
  359.       |     eArray:
  360.         PtrToArray := Info;
  361.         WriteS (StdError, PtrToArray^);
  362.       |     eIdent:
  363.         PtrToIdent := Info;
  364.         WriteIdent (StdError, PtrToIdent^);
  365.       |     eTermSet:
  366.         PtrToSet := Info;
  367.         WriteTermSet (StdError, PtrToSet^);
  368.       ELSE      WriteS (StdError, 'Info Class: ');
  369.           WriteI (StdError, InfoClass, 1);
  370.       END;
  371.    END WriteInfo;
  372.  
  373. PROCEDURE WriteTermSet (f: tFile; s:tSet);
  374.   VAR i : CARDINAL;
  375.       Error: TokenError;
  376.   BEGIN
  377.     FOR i := 0 TO MAXTerm DO
  378.       IF IsElement (i, s) THEN
  379.     WriteS (f, ' ');
  380.     WriteIdent (f, TokenToSymbol (i, Error));
  381.       END;
  382.     END;
  383.   END WriteTermSet;
  384.  
  385. PROCEDURE SplitLine (line: tString; VAR i: CARDINAL; VAR s1: tString);
  386.   VAR
  387.     m, p1, p2 : CARDINAL;
  388.     s : tString;
  389.   BEGIN
  390.     p1 := 1;
  391.     p2 := 1;
  392.     m := Length (line);
  393.     LOOP
  394.       IF p2 > m THEN EXIT; END;
  395.       IF Char (line, p2) = cTab THEN EXIT; END;
  396.       INC (p2);
  397.     END;
  398.     DEC (p2);
  399.     IF p1 > p2 THEN 
  400.       i := 0;
  401.     ELSE
  402.       SubString (line, p1, p2, s);
  403.       i := StringToInt (s);
  404.     END;
  405.  
  406.     p1 := p2+1;
  407.     LOOP
  408.       IF p1 > m THEN EXIT; END;
  409.       IF Char (line, p1) # cTab THEN EXIT; END;
  410.       INC (p1);
  411.     END;
  412.     p2 := p1;
  413.     LOOP
  414.       IF p2 > m THEN EXIT; END;
  415.       IF Char (line, p2) = cTab THEN EXIT; END;
  416.       INC (p2);
  417.     END;
  418.     DEC (p2);
  419.     IF p1 > p2 THEN
  420.       AssignEmpty (s1);
  421.     ELSE
  422.       SubString (line, p1, p2, s1);
  423.     END;
  424.  
  425.   END SplitLine;
  426.  
  427. PROCEDURE Finish;
  428.   BEGIN
  429.     CloseErrors;
  430.     CloseIO;
  431.     Exit (1);
  432.   END Finish;
  433.  
  434. BEGIN
  435.   NoReports := TRUE;
  436.   ReportMode := eNoListing;
  437.   ErrorTable := 'ErrorTab';
  438.   ReportClass := {0..MaxErrorClass};
  439.  
  440.   FOR i := 0 TO MaxErrorClass DO
  441.     ErrorCount [i] := 0;
  442.   END;
  443.  
  444.   FOR i := 0 TO MaxErrorClass DO
  445.     ErrorClassRef [i] := NoStringRef;
  446.   END;
  447.  
  448.   FOR i := 0 TO MaxCode DO
  449.     ErrorCodeRef [i] := NoStringRef;
  450.   END;
  451.  
  452.   FOR i := 0 TO MaxErrorClass DO
  453.     ErrorCountRef [i] := NoStringRef;
  454.   END;
  455. END Errors.
  456.